home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / Slider.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  2.4 KB  |  90 lines
  1. PROGRAM Slider;
  2.  
  3. uses triton, tritonmacros, utility, vartags;
  4.  
  5. {
  6.    A demo in FPC Pascal using triton.library
  7.    
  8.    nils.sjoholm@mailbox.swipnet.se
  9. }
  10.  
  11.  
  12.  
  13. VAR
  14.      Project  : pTR_Project;
  15.      close_me : BOOLEAN;
  16.      trmsg : pTR_Message;
  17.      dummy : longint;
  18.      Triton_App : pTR_App;
  19.  
  20. Function IntToStr (I : Longint) : String;
  21.  
  22.      Var S : String;
  23.  
  24.      begin
  25.       Str (I,S);
  26.       IntToStr:=S;
  27.      end;
  28.  
  29. begin
  30.  
  31.     Triton_App := TR_CreateApp(Tags(
  32.                      TRCA_Name,longstr(' Triton Slider Demo') ,
  33.                      TRCA_Release,longstr(' 1') ,
  34.                      TRCA_Date,longstr(' 03-08-1998') ,
  35.                      TAG_DONE));
  36.      
  37.     if Triton_App <> nil then begin
  38.       ProjectStart;
  39.       WindowID(1);
  40.       WindowTitle(' Slider' );
  41.          VertGroupA;
  42.             Space;
  43.             HorizGroupAC;
  44.                Space;
  45.                TextID(' _Slider' ,1);
  46.                Space;
  47.                SliderGadget(1,100,50,1);
  48.                Space;
  49.                TextID(' 50' ,2); SetTRTag(TRAT_MinWidth,3);
  50.                Space;
  51.             EndGroup;
  52.             Space;
  53.          EndGroup;
  54.       EndProject;
  55.  
  56.   Project := TR_OpenProject(Triton_App,@tritontags);
  57.     IF Project <> NIL THEN BEGIN
  58.       close_me := FALSE;
  59.       WHILE NOT close_me DO BEGIN
  60.         dummy := TR_Wait(Triton_App,0);
  61.         REPEAT
  62.           trmsg := TR_GetMsg(Triton_App);
  63.           IF trmsg <> NIL THEN BEGIN
  64.             IF (trmsg^.trm_Project = Project) THEN BEGIN
  65.                CASE trmsg^.trm_Class OF
  66.                  TRMS_CLOSEWINDOW : begin
  67.                                        writeln(' The final number was: ' ,TR_GetValue(Project,1));
  68.                                        close_me := True;
  69.                                     end;
  70.                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  71.                  TRMS_NEWVALUE    : begin
  72.                                        IF trmsg^.trm_ID = 1 then begin
  73.                                           writeln(' The number is: ' ,trmsg^.trm_Data);
  74.                                           TR_SetText(Project,2,IntToStr(trmsg^.trm_Data));
  75.                                        end;
  76.                                     end;
  77.                END;
  78.             END;
  79.             TR_ReplyMsg(trmsg);
  80.           END;
  81.         UNTIL close_me OR (trmsg = NIL);
  82.       END;
  83.      TR_CloseProject(Project);
  84.    end;
  85.    TR_DeleteApp(Triton_App);
  86.    END ELSE writeln(' Cant create Application');
  87. end.
  88.  
  89.  
  90.